#!/usr/bin/env perl
# server.pl
#
# Basic HTTP web server without installing any extra modules
# Supports directory listing, mimetype handling etc.
#
# License: CC0 1.0 (https://creativecommons.org/publicdomain/zero/1.0/)

# This is the first basic, simple version of the server.
# A more advanced version with watch and possibly other features is available
# in server.pl

# Usage:
# - Have Perl installed
# - Run "perl server.pl"
# - Visit "http://localhost:7777" on a web browser

# Limitations:
# - Does not handle POST (only GET for now)

# Original (public domain):
# https://renenyffenegger.ch/notes/development/languages/Perl/modules/IO/Socket/echo-server-client

use warnings;
use strict;

use IO::Socket::INET;
use Net::hostent;  # for OO version of gethostbyaddr

# To handle CLI parameters
use Getopt::Long;

use File::Basename;
use Cwd qw( abs_path cwd );
my $script_dir = abs_path(dirname($0));
# Set $PWD/public as webroot
my $webroot_dir = $script_dir . '/public';
# Fallback to current directory in case $script_dir/public is not found
unless ( -d $webroot_dir ) {
	$webroot_dir = cwd();
}

my $port_listen = 7777;

$| = 1; # Autoflush

# Shows up when --help or -h is passed
sub help_text {
	print("usage: server.pl [-h] [-p PORT] [-d WEBROOT]

A simple HTTP web server in Perl.

optional arguments:
  -h, --help            show this help message and exit
  -p PORT, --port PORT
                        port to listen for requests [default:7777]
  -d WEBROOT, --directory WEBROOT
                        directory of the files to serve [default:public or \$PWD]

examples:
  start server in 7777 port and serve files in public or \$PWD:
    \$ ./server.pl
  start server in 3344 port and serve files in www/static directory
    \$ ./server.pl -p 3344 -d www/static\n");
	exit;
}

# Process CLI parameters and update config values as necessary
GetOptions ("p|port=i"      => \$port_listen,
			"d|directory=s" => \$webroot_dir,
			"h|help"        => \&help_text)
or die("Error in command line arguments. Please review and try again. Run with -h for help.\n");

my $socket = IO::Socket::INET->new(

  LocalHost   => '0.0.0.0',
  LocalPort   =>  $port_listen,
  Proto       => 'tcp',
  Listen      =>  5,
  Reuse       =>  1

) or die "Cannot create socket. The port $port_listen is probably already being used? Please pass -p PORT to set a different port or stop already running instances of this script.";

print "> Server started\n";
print "> Waiting for requests on http://localhost:${port_listen}\n";

my $request_path;
my $content='';
my $host;

while ( my $client = $socket->accept() ) {

	# Host related
	my $hostinfo = gethostbyaddr($client->peeraddr);
	$host = $client->peerhost();

	my $request;
	my $request_url = '';
	my $request_params = '';
	my $request_url_full;
	my $request_method;
	# Response related
	my $response_mimetype = 'text/plain';

	local $/ = Socket::CRLF;
	# Read request up to an empty line
	while ( <$client> ) {
		last unless /\S/;
		if (/(\S+) ([^\?]+)(\?.*)? HTTP\//) {
			$request_method = $1;
			$request_url = $2;
			$request_params = $3; # GET params. e.g. "?test=1"
		}
	}
	$request_url_full = $host . ':' . $port_listen . $request_url;

	$request_path = $webroot_dir . $request_url;

	if ( -d $request_path ) {
		if ( -f "${request_path}/index.html" ) {
			$request_path = "${request_path}/index.html";
		} elsif ( -f "${request_path}/index.htm" ) {
			$request_path = "${request_path}/index.htm";
		} else {
			opendir DIR, $request_path;
			my @dir = sort readdir(DIR);
			close DIR;
			# Indicate that we're outputting HTML for the page
			$response_mimetype = 'text/html';
			# Prepare the content for the file index
			$content = "<h1>${request_url_full}</h1>";
			$content .= "<ul>";
			foreach (@dir) {
				if ( -d $request_path . $_ ) {
					$content .= "<li><strong><a href=\"http://${request_url_full}/$_\">$_</a></strong></li>";
				} else {
					$content .= "<li><a href=\"http://${request_url_full}/$_\">$_</a></li>";
				}
			}
			$content .= "</ul>";
		}
		print "> Directory requested. Will serve index HTML instead if found or a directory file list.\n";
	}
	# File is there, so show its content.
	if ( -f $request_path ) {
		open my $CRF, '<', $request_path or die "Can't open cache file $!";
		$content = do { local $/; <$CRF> };
		close($CRF);
	# File does not exist and no directory index content is there to serve.
	# So show error.
	} elsif ( $content eq '' ) {
		print "> ${request_url_full} does not exist, so serving an error instead\n";
		$content = "ERROR: ${request_url_full} could not be found";
	}

	# Set mimetype
	if ( $request_path =~ /\.htm$/ or $request_path =~ /\.html$/ ) {
		$response_mimetype = 'text/html';
	} elsif ( $request_path =~ /\.js$/ ) {
		$response_mimetype = 'text/javascript';
	} elsif ( $request_path =~ /\.css$/ ) {
		$response_mimetype = 'text/css';
	} elsif ( $request_path =~ /\.png$/ ) {
		$response_mimetype = 'image/png';
	} elsif ( $request_path =~ /\.jpg$/ or $request_path =~ /\.jpeg$/ ) {
		$response_mimetype = 'image/jpeg';
	} elsif ( $request_path =~ /\.ico$/ ) {
		$response_mimetype = 'image/x-icon';
	} elsif ( $request_path =~ /\.gif$/ ) {
		$response_mimetype = 'image/gif';
	} elsif ( $request_path =~ /\.svg$/ ) {
		$response_mimetype = 'image/svg+xml';
	} elsif ( $request_path =~ /\.webp$/ ) {
		$response_mimetype = 'image/webp';
	} else {
		print "> Mimetype is not programmed in server for $request_url! Serving as ${response_mimetype}\n";
	}

	# Send header and content
    print $client "HTTP/1.0 200 OK", Socket::CRLF;
    print $client "Content-type: $response_mimetype", Socket::CRLF;
    print $client Socket::CRLF;
	$client->send( $content );

	# Close client and print a message on console
	close $client;
	print "> Request for ${request_url_full} has been answered\n";

}
